home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: Alpha / Whiteline Alpha.iso / progtool / modula2 / hk_lib / def_mod / mathbase.mod < prev    next >
Encoding:
Modula Implementation  |  1994-09-22  |  20.8 KB  |  599 lines
  1. IMPLEMENTATION MODULE  MathBase;
  2.  
  3. (*****************************************************************************)
  4. (* In LPR-Modula wird die IEEE-Zahlendarstellung fuer REAL- und LONGREAL-    *)
  5. (* Zahlen benutzt, womit folgende Aufteilung der durch solche Zahlen belegten*)
  6. (* Bytes gegeben ist:                                                        *)
  7. (*                                                                           *)
  8. (*   REAL: 4 Bytes                                                           *)
  9. (*   Bitnr.: 30             22                         0                     *)
  10. (*          -------------------------------------------                      *)
  11. (*         |s| 8-Bit-Exp. e |   23-Bit-Bruchteil  f    |                     *)
  12. (*          -------------------------------------------                      *)
  13. (*          ^                                                                *)
  14. (*          | Vorzeichen Mantisse                                            *)
  15. (*                                                                           *)
  16. (*                                                                           *)
  17. (*   LONGREAL: 8 Bytes                                                       *)
  18. (*   Bitnr.: 62              51                                           0  *)
  19. (*          --------------------------------------------------------------   *)
  20. (*         |s| 11-Bit-Exp. e |            52-Bit-Bruchteil  f             |  *)
  21. (*          --------------------------------------------------------------   *)
  22. (*                                                                           *)
  23. (* In  f  wird der Absolutwert des gebrochenen Anteils der Mantisse gespei-  *)
  24. (* chert, das Vorzeichen wird gesondert gefuehrt. Zur vollstaendigen Mantisse*)
  25. (* fehlt noch die eins vor dem Komma, die aber nicht abgespeichert wird, da  *)
  26. (* sie immer vorhanden ist ( normalisierte Darstellung ).                    *)
  27. (* Der Exponent  e  ist eine Zahl im Zweierkomplement, die allerdings mit    *)
  28. (* einem Offset ( BIAS ) versehen wird, sodass sie als vorzeichenlose Zahl   *)
  29. (* behandelt werden kann.                                                    *)
  30. (*                                                                           *)
  31. (* Der Wert der Zahlen laesst sich folgendermassen berechnen:                *)
  32. (*                                                                           *)
  33. (*   REAL:     (-1)^s * 2^(e-127)  * 1.f    ; 0 < e < 255  , 0.0 <= f < 1.0  *)
  34. (*                                                                           *)
  35. (*   LONGREAL: (-1)^s * 2^(e-1023) * 1.f    ; 0 < e < 2047 , 0.0 <= f < 1.0  *)
  36. (*                                                                           *)
  37. (*                                                                           *)
  38. (* Der darstellbare Zahlenbereich ist dann:                                  *)
  39. (*                                                                           *)
  40. (*   REAL:     kleinste Zahl: 2^(1-127)     * 1.0          = 1.17549..E-038  *)
  41. (*             groesste Zahl: 2^(254-127)   * 2.0-2^(-23)  = 3.40282..E+038  *)
  42. (*                                                                           *)
  43. (*   LONGREAL: kleinste Zahl: 2^(1-1023)    * 1.0          = 2.22507..E-308  *)
  44. (*             groesste Zahl: 2^(2046-1023) * 2.0-2^(-52)  = 1.79769..E+308  *)
  45. (*                                                                           *)
  46. (*                                                                           *)
  47. (* Die bei dieser Darstellung nicht verwendeten Extremwerte der Exponenten   *)
  48. (* werden im Zusammenhang mit bestimmten Mantissenwerten zur Darstellung     *)
  49. (* spezieller Werte und Zahlen benutzt:                                      *)
  50. (*                                                                           *)
  51. (*   e = 255 bzw. 2047 und f = 0:  Darstellung von Unendlich                 *)
  52. (*                                                                           *)
  53. (*   e = 255 bzw. 2047 und f # 0:  Not a Number ( NAN ), nicht darstellbarer *)
  54. (*                                 Zahlenwert, kann Exception ausloesen.     *)
  55. (*                                                                           *)
  56. (*   e = 0             und f = 0:  Darstellung der Null ( mit Vorzeichen )   *)
  57. (*                                                                           *)
  58. (*   e = 0             und f # 0:  sogenannte denormalisierte Zahlen, hiermit*)
  59. (*                                 koennen sehr kleine Zahlen unterhalb der  *)
  60. (*                                 kleinsten darstellbaren Zahl der normali- *)
  61. (*                                 sierten Zahlen dargestellt werden.        *)
  62. (*                                                                           *)
  63. (*   Fuer denormalisierte Zahlen gilt:                                       *)
  64. (*                                                                           *)
  65. (*   REAL:     Wert:          (-1)^s * 2^(-126)  * 0.f    ;   0.0 < f < 1.0  *)
  66. (*                                                                           *)
  67. (*             kleinste Zahl:          2^(-126)  * 2^(-23) = 1.40129..E-045  *)
  68. (*                                                                           *)
  69. (*   LONGREAL: Wert:          (-1)^s * 2^(-1022) * 0.f    ;   0.0 < f < 1.0  *)
  70. (*                                                                           *)
  71. (*             kleinste Zahl:          2^(-1022) * 2^(-52) = 4.94065..E-324  *)
  72. (*                                                                           *)
  73. (*                                                                           *)
  74. (* LPR-Modula verwendet keine denormalisierten Zahlen, sodass eine Zahl Null *)
  75. (* ist, wenn ihr Exponent Null ist ( gilt nicht beim Vergleich mit 0.0, da   *)
  76. (* hier bitweise verglichen wird ).                                          *)
  77. (*___________________________________________________________________________*)
  78. (* 13-Jan-90 , hk   Beginn                                                   *)
  79. (* 26-Jan-90 , hk   erste Version                                            *)
  80. (* 28-Jan-90 , hk                                                            *)
  81. (*        neu: "GetFraction", "GetLongFraction"                              *)
  82. (*        "MakeReal", "MakeLongReal" in Assembler                            *)
  83. (* 08-Feb-90 , hk                                                            *)
  84. (*        "SIGN", "SIGND", "INTSIGN" neu                                     *)
  85. (* 03-Mae-90 , hk                                                            *)
  86. (*        Konstanten im Definitionsmodul neu, "real","Real","entier","Entier"*)
  87. (*        "round","Round" neu                                                *)
  88. (*****************************************************************************)
  89.  
  90. FROM  SYSTEM  IMPORT  (* PROC *)  VAL, SETREG, SHIFT, LONG, INLINE;
  91.  
  92. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  93.  
  94. CONST
  95.       exponent = BITSET{ 7..14 };
  96.       longexp  = BITSET{ 4..14 };
  97.  
  98. TYPE
  99.       (* Um auf Teile der REAL-Zahlen zugreifen zu koennen,
  100.        * werden folgende Typen deklariert; mit ihnen koennen
  101.        * die Zahlen alternativ als Folge von CARDINAL-Zahlen
  102.        * angesprochen werden, wobei hier nur der Teil inter-
  103.        * essant ist, der den Exponenten enthaelt.
  104.        *)
  105.  
  106.       RealCard =
  107.          RECORD
  108.            CASE :BOOLEAN  OF
  109.               FALSE: real  : REAL;
  110.              |TRUE : ch,cl : CARDINAL;
  111.            END;
  112.          END;
  113.  
  114.       LongrealCard =
  115.          RECORD
  116.            CASE :BOOLEAN  OF
  117.               FALSE : longreal        : LONGREAL;
  118.              |TRUE  : chh,chl,clh,cll : CARDINAL;
  119.            END;
  120.          END;
  121.  
  122. VAR
  123.       lr       : LongrealCard; (* Fuer die "LONGREAL-Konstanten" *)
  124.       MAXrlint,
  125.       MINrlint : LONGREAL;
  126.       MAXrint,
  127.       MINrint  : REAL;
  128.  
  129. (*===========================================================================*)
  130.  
  131. PROCEDURE SplitReal ((* EIN/ -- *)     value : REAL;
  132.                      (* -- /AUS *) VAR exp   : INTEGER ): REAL;
  133. (*T*)
  134.   CONST bias = 127;
  135.  
  136.   VAR   zahl : RealCard;
  137.  
  138.   BEGIN
  139.     zahl.real := value;
  140.  
  141.     IF  VAL( BITSET, zahl.ch ) * exponent = { }  THEN
  142.  
  143.       (* Eine REAL-Zahl ist nur dann Null, wenn sowohl
  144.        * Mantisse als auch Exponent Null sind; ein
  145.        * CARDINAL-Vergleich ist wesentlich schneller.
  146.        * Waere nur der Exponent Null, aber nicht die
  147.        * Mantisse, handelte es sich um eine sog, 'denor-
  148.        * malisierte Zahl', die aber vom Laufzeitsystem
  149.        * nicht unterstuezt wird; deshalb reicht es, den
  150.        * Exponenten zu ueberpruefen.
  151.        *)
  152.       exp := 0;
  153.       RETURN( 0.0 );
  154.     ELSE
  155.       exp     := ( VAL( CARDINAL,
  156.                    VAL( BITSET, zahl.ch ) * exponent ) DIV 128 ) - bias ;
  157.  
  158.       zahl.ch := VAL( CARDINAL,
  159.                  VAL( BITSET, zahl.ch ) - exponent ) + bias * 128;
  160.  
  161.     END; (* IF zahl.ch *)
  162.  
  163.     RETURN( zahl.real );
  164.   END  SplitReal;
  165.  
  166. (*---------------------------------------------------------------------------*)
  167.  
  168. PROCEDURE SplitLongReal ((* EIN/ -- *)     value : LONGREAL;
  169.                          (* -- /AUS *) VAR exp   : INTEGER   ): LONGREAL;
  170. (*T*)
  171.   CONST bias = 1023;
  172.  
  173.   VAR   zahl : LongrealCard;
  174.  
  175.   BEGIN
  176.     zahl.longreal := value;
  177.  
  178.     IF  VAL( BITSET, zahl.chh ) * longexp = { }  THEN
  179.       exp := 0;
  180.       RETURN( 0.0D );
  181.     ELSE
  182.       exp      := ( VAL( CARDINAL,
  183.                     VAL( BITSET, zahl.chh ) * longexp ) DIV 16 ) - bias ;
  184.  
  185.       zahl.chh := VAL( CARDINAL,
  186.                   VAL( BITSET, zahl.chh ) - longexp ) + bias * 16;
  187.  
  188.     END; (* IF zahl.chh *)
  189.  
  190.     RETURN( zahl.longreal );
  191.   END  SplitLongReal;
  192.  
  193. (*---------------------------------------------------------------------------*)
  194.  
  195. PROCEDURE MakeReal ((* EIN/ -- *) value : REAL;
  196.                     (* EIN/ -- *) exp   : INTEGER ): REAL;
  197. (*T*)
  198. (* VAR   beides : RealCard; *)
  199.  
  200.    BEGIN
  201. (*   beides.real := value;
  202.  
  203.      IF  VAL( BITSET, beides.ch ) * exponent # { }  THEN
  204.  
  205.        INC( exp, VAL( CARDINAL, VAL( BITSET, beides.ch) * exponent ) DIV 128 );
  206.  
  207.        IF     exp < 1  THEN    (* Unterlauf *)
  208.           RETURN( 0.0 );
  209.        ELSIF  exp > 254  THEN  (* Ueberlauf *)
  210.           RETURN( MAX(REAL));
  211.        END; (* IF exp *)
  212.  
  213.        beides.ch :=   VAL( CARDINAL, VAL( BITSET, beides.ch ) - exponent )
  214.                     + VAL( CARDINAL, exp ) * 128;
  215.  
  216.      END; (* IF beides.ch *)
  217.  
  218.      RETURN( beides.real );
  219.  
  220.       ++++++++++++++++++++++++++++++++++++++++++++++++++
  221.  
  222.     Achtung: Die Ueberlaufbehandlung ist genauer als bei
  223.              der MODULA-Version, deswegen sollte diese
  224.              Assemblerversion benutzt werden
  225.  
  226.     expmsk  EQU $7F80
  227.     maxreal EQU $7F7FFFFF
  228.  
  229.     exp     EQU 12
  230.     value   EQU exp + 2
  231.     RETURN  EQU value + 4
  232.  
  233.     MakeReal:
  234.       move.l  value(a6), d0
  235.       swap    d0                 ; Es interessiert nur der Exponent
  236.       move.w  d0, d1             ; auch im 'Arbeitsregister'
  237.       andi.w  #$FFFF-expmsk, d0  ; Exponenten loeschen
  238.       andi.w  #expmsk, d1        ; hier nur den Exponenten
  239.       beq.s   ufl                ; Exponent Null => Zahl Null ( nicht denorm.)
  240.       lsr.w   #7, d1             ; Exp. als CARDINAL-Zahl
  241.       add.w   exp(a6), d1        ; gewuenschten Faktor addieren
  242.                                  ; und Ergebnis als INTEGER behandeln
  243.       bvs.s   ofl                ; B: das war zuviel
  244.       cmpi.w  #1, d1             ; Unterlauf ?
  245.       bge.s   tstofl             ; B: nein
  246.     ufl:
  247.       moveq   #0, d0             ; keine denormalisierten Zahlen, einfach Null
  248.       bra.s   ende               ;
  249.     tstofl:
  250.       cmpi.w  #254, d1           ; Ueberlauf ?
  251.       ble.s   ok                 ; B: nein
  252.     ofl:
  253.       move.l  #maxreal, d0       ; groesste REAL-Zahl zurueckgeben
  254.       bra.s   ende               ;
  255.     ok:
  256.       lsl.w   #7, d1             ; Exp. wieder an die richtige Stelle bringen
  257.       or.w    d1, d0             ;
  258.       swap    d0                 ;
  259.     ende:
  260.       move.l  d0, RETURN(a6)
  261. *)
  262.     INLINE( 202EH,000EH,4840H,3200H,0240H,807FH,0241H,7F80H,670EH );
  263.     INLINE( 0EE49H,0D26EH,000CH,6910H,0C41H,0001H,6C04H,7000H,6014H );
  264.     INLINE( 0C41H,00FEH,6F08H,203CH,7F7FH,0FFFFH,6006H,0EF49H,8041H );
  265.     INLINE( 4840H,2D40H,0012H );
  266.  
  267.   END  MakeReal;
  268.  
  269. (*---------------------------------------------------------------------------*)
  270.  
  271. PROCEDURE MakeLongReal ((* EIN/ -- *) value : LONGREAL;
  272.                         (* EIN/ -- *) exp   : INTEGER   ): LONGREAL;
  273. (*T*)
  274. (* VAR   beides : LongrealCard; *)
  275.  
  276.    BEGIN
  277. (*   beides.longreal := value;
  278.  
  279.      IF  VAL( BITSET, beides.chh ) * longexp # { }  THEN
  280.  
  281.         INC( exp, VAL( CARDINAL, VAL( BITSET, beides.chh) * longexp ) DIV 16 );
  282.  
  283.         IF     exp < 1  THEN            (* Unterlauf *)
  284.            RETURN( 0.0D );
  285.         ELSIF  exp > 2046  THEN         (* Ueberlauf *)
  286.            RETURN( MAX(LONGREAL));
  287.         END; (* IF  exp *)
  288.  
  289.         beides.chh :=   VAL( CARDINAL, VAL( BITSET, beides.chh ) - longexp )
  290.                       + VAL( CARDINAL, exp ) * 16;
  291.  
  292.      END; (* IF beides.chh *)
  293.  
  294.      RETURN( beides.longreal );
  295.  
  296.       ++++++++++++++++++++++++++++++++++++++++++++++++++
  297.  
  298.      maxlong EQU $7FEFFFFF
  299.      expmsk  EQU $7FF0
  300.  
  301.      exp     EQU 12
  302.      value   EQU exp + 2
  303.      RETURN  EQU value + 8
  304.  
  305.      MakeReal:
  306.        move.l  value(a6), d0
  307.        swap    d0
  308.        move.w  d0, d1
  309.        andi.w  #$FFFF-expmsk, d0
  310.        andi.w  #expmsk, d1
  311.        beq.s   ufl
  312.        lsr.w   #4, d1
  313.        add.w   exp(a6), d1
  314.        bvs.s   ofl
  315.        cmpi.w  #1, d1
  316.        bge.s   tstofl
  317.      ufl:
  318.        moveq   #0, d0
  319.        move.l  d0, value+4(a6)   ; nicht das zweite Langwort einer LONGREAL-
  320.                                  ; Zahl vergessen
  321.        bra.s   ende
  322.      tstofl:
  323.        cmpi.w  #2046, d1
  324.        ble.s   ok
  325.      ofl:
  326.        moveq   #-1, d0
  327.        move.l  d0, value+4(a6)
  328.        move.l  #$maxlong, d0
  329.        bra.s   ende
  330.      ok:
  331.        lsl.w   #4, d1
  332.        or.w    d1, d0
  333.        swap    d0
  334.      ende:
  335.        move.l  d0, RETURN(a6)
  336.        move.l  value+4(a6), RETURN+4(a6)
  337. *)
  338.      INLINE( 202EH,000EH,4840H,3200H,0240H,800FH,0241H,7FF0H,670EH );
  339.      INLINE( 0E849H,0D26EH,000CH,6914H,0C41H,0001H,6C08H,7000H,2D40H );
  340.      INLINE( 0012H,601AH,0C41H,07FEH,6F0EH,70FFH,2D40H,0012H,203CH );
  341.      INLINE( 7FEFH,0FFFFH,6006H,0E949H,8041H,4840H,2D40H,0016H,2D6EH );
  342.      INLINE( 0012H,001AH );
  343.  
  344.   END  MakeLongReal;
  345.  
  346. (*---------------------------------------------------------------------------*)
  347.  
  348. PROCEDURE  GetFraction ((* EIN/ -- *)     value : REAL;
  349.                         (* -- /AUS *) VAR int   : INTEGER ): REAL;
  350. (*T*)
  351.    BEGIN
  352.      int := TRUNC( value );
  353.  
  354.      (* TRUNC liefert INTEGER-Zahlen, aber FLOAT
  355.       * liefert bei negativen Zahlen falsche
  356.       * Werte. Da der Compiler die Anwendung von
  357.       * FLOAT auf negative Konstanten akzeptiert,
  358.       * liegts wohl mal wieder am Laufzeitmodul.
  359.       *
  360.       * Das LONG() ist fuer den Fall  int = MIN(INTEGER)
  361.       * noetig.
  362.       *)
  363.  
  364.      RETURN( ABS( value ) - FLOAT( ABS( LONG( int ))));
  365.    END  GetFraction;
  366.  
  367. (*---------------------------------------------------------------------------*)
  368.  
  369. PROCEDURE  GetLongFraction ((* EIN/ -- *)     value : LONGREAL;
  370.                             (* -- /AUS *) VAR int   : INTEGER  ): LONGREAL;
  371. (*T*)
  372.    BEGIN
  373.      int := TRUNCD( value );
  374.  
  375.      RETURN( ABS( value ) - FLOATD( ABS( LONG( int ))));
  376.    END  GetLongFraction;
  377.  
  378. (*---------------------------------------------------------------------------*)
  379.  
  380. PROCEDURE  SIGN ((* EIN/ -- *) zahl : REAL ): INTEGER;
  381. (*T*)
  382.   BEGIN
  383. (*
  384.     expmsk  EQU  $7F80
  385.  
  386.     zahl    EQU  12
  387.     RETURN  EQU  zahl + 4
  388.  
  389.     SIGN:
  390.       moveq   #0, d2        ; Default: Sign(x) = 0
  391.       move.w  zahl(a6), d0
  392.       move.w  d0, d1
  393.       andi.w  #expmsk, d1   ; Exponent = 0 ?
  394.       beq.s   ende          ; B: ja, dann Zahl Null und auch Sign(x) = 0
  395.       moveq   #1, d2
  396.       tst.w   d0            ; zahl positiv ( Bit 15 ist Vorzeichen ) ?
  397.       bpl.s   ende          ; B: ja, Sign(x) = 1
  398.       moveq   #-1, d2       ; sonst Sign(x) = -1
  399.     ende:
  400.       move.w  d2, RETURN(a6)
  401. *)
  402.     INLINE( 7400H,302EH,000CH,3200H,0241H,7F80H,6708H,7401H,4A40H );
  403.     INLINE( 6A02H,74FFH,3D42H,0010H );
  404.  
  405.   END  SIGN;
  406.  
  407. (*---------------------------------------------------------------------------*)
  408.  
  409. PROCEDURE  SIGND ((* EIN/ -- *) zahl : LONGREAL ): INTEGER;
  410. (*T*)
  411.   BEGIN
  412. (* Das gleiche wie "SIGN", nur anderer
  413.    Offset fuer RETURN, und andere Exponentmaske
  414.  
  415.     expmsk  EQU  $7FF0
  416.  
  417.     zahl    EQU  12
  418.     RETURN  EQU  zahl + 8
  419.  
  420.     SIGND:
  421.       moveq   #0, d2
  422.       move.w  zahl(a6), d0
  423.       move.w  d0, d1
  424.       andi.w  #expmsk, d1
  425.       beq.s   ende
  426.       moveq   #1, d2
  427.       tst.w   d0
  428.       bpl.s   ende
  429.       moveq   #-1, d2
  430.     ende:
  431.       move.w  d2, RETURN(a6)
  432. *)
  433.     INLINE( 7400H,302EH,000CH,3200H,0241H,7FF0H,6708H,7401H,4A40H );
  434.     INLINE( 6A02H,74FFH,3D42H,0014H );
  435.  
  436.   END  SIGND;
  437.  
  438. (*---------------------------------------------------------------------------*)
  439.  
  440. PROCEDURE  INTSIGN ((* EIN/ -- *) zahl : LONGINT ): INTEGER;
  441. (*T*)
  442.   BEGIN
  443. (*
  444.     zahl    EQU  12
  445.     RETURN  EQU  zahl + 4
  446.  
  447.     INTSIGN:
  448.       move.l  zahl(a6), d0
  449.       beq.s   ende
  450.       bmi.s   neg
  451.       moveq   #1, d0
  452.       bra.s   ende
  453.     neg:
  454.       moveq   #-1, d0
  455.     ende2:
  456.       move.w  d0, RETURN(a6)
  457. *)
  458.     INLINE( 202EH,000CH,6708H,6B04H,7001H,6002H,70FFH,3D40H,0010H );
  459.  
  460.   END  INTSIGN;
  461.  
  462. (*---------------------------------------------------------------------------*)
  463.  
  464. PROCEDURE  real ((* EIN/ -- *) int : INTEGER ): REAL;
  465. (*T*)
  466.  BEGIN
  467.   IF  int < 0  THEN
  468.     RETURN( -FLOAT( -LONG( int )));
  469.     (* LONG( int ), damit auch
  470.      * int = MIN( INTEGER ) funktioniert.
  471.      *)
  472.   ELSE
  473.     RETURN( FLOAT( int ));
  474.   END;
  475.  END  real;
  476.  
  477. (*---------------------------------------------------------------------------*)
  478.  
  479. PROCEDURE  Real ((* EIN/ -- *) lint : LONGINT ): LONGREAL;
  480. (*T*)
  481.  BEGIN
  482.   RETURN( FLOATD( lint )); (* FLOATD funktioniert auch bei negativen Zahlen *)
  483.  END  Real;
  484.  
  485. (*---------------------------------------------------------------------------*)
  486.  
  487. PROCEDURE  entier ((* EIN/ -- *) real : REAL ): INTEGER;
  488. (*T*)
  489.  BEGIN
  490.   IF  SIGN( real ) >= 0  THEN
  491.     IF  real >= MAXint  THEN
  492.       RETURN( MAX( INTEGER ));
  493.     ELSE
  494.       RETURN( TRUNC( real ));
  495.     END;
  496.   ELSIF real <= MINint  THEN
  497.     (* Diesen Wert packt TRUNC nicht mehr,
  498.      * deshalb gesondert betrachten
  499.      *)
  500.     RETURN( MIN( INTEGER ));
  501.   ELSIF -FLOAT( TRUNC( -real )) = real  THEN
  502.     (* Wenn <real> eine glatte negative Zahl ist,
  503.      * dann nicht um eins verringern.
  504.      *)
  505.     RETURN( TRUNC( real ));
  506.   ELSE
  507.     RETURN( TRUNC( real ) - 1 );
  508.   END;
  509.  END  entier;
  510.  
  511. (*---------------------------------------------------------------------------*)
  512.  
  513. PROCEDURE  Entier ((* EIN/ -- *) lreal : LONGREAL ): LONGINT;
  514. (*T*)
  515.  BEGIN
  516.   IF  SIGND( lreal ) >= 0  THEN
  517.     IF  lreal >= MAXlongint  THEN
  518.       RETURN( MAX( LONGINT ));
  519.     ELSE
  520.       RETURN( TRUNCD( lreal ));
  521.     END;
  522.   ELSIF lreal <= MINlongint  THEN
  523.     (* Diesen Wert packt TRUNCD nicht mehr,
  524.      * deshalb gesondert betrachten
  525.      *)
  526.     RETURN( MIN( LONGINT ));
  527.   ELSIF -FLOATD( TRUNCD( -lreal )) = lreal  THEN
  528.     (* Wenn <lreal> eine glatte negative Zahl ist,
  529.      * dann nicht um eins verringern.
  530.      *)
  531.     RETURN( TRUNCD( lreal ));
  532.   ELSE
  533.     RETURN( TRUNCD( lreal ) - 1D );
  534.   END;
  535.  END  Entier;
  536.  
  537. (*---------------------------------------------------------------------------*)
  538.  
  539. PROCEDURE  round ((* EIN/ -- *) real : REAL ): INTEGER;
  540. (*T*)
  541. BEGIN
  542.  IF  SIGN( real ) = -1  THEN
  543.    IF  real <= MINrint  THEN
  544.      RETURN( MIN( INTEGER ));
  545.    ELSE
  546.      RETURN( TRUNC( real - 0.5 ));
  547.    END;
  548.  ELSE
  549.    IF  real >= MAXrint  THEN
  550.      RETURN( MAX( INTEGER ));
  551.    ELSE
  552.      RETURN( TRUNC( real + 0.5 ));
  553.    END;
  554.  END;
  555. END  round;
  556.  
  557. (*---------------------------------------------------------------------------*)
  558.  
  559. PROCEDURE  Round ((* EIN/ -- *) lreal : LONGREAL ): LONGINT;
  560. (*T*)
  561. BEGIN
  562.  IF  SIGND( lreal ) = -1  THEN
  563.    IF  lreal <= MINrlint  THEN
  564.      RETURN( MIN( LONGINT ));
  565.    ELSE
  566.      RETURN( TRUNCD( lreal - 0.5D ));
  567.    END;
  568.  ELSE
  569.    IF  lreal >= MAXrlint  THEN
  570.      RETURN( MAX( LONGINT ));
  571.    ELSE
  572.      RETURN( TRUNCD( lreal + 0.5D ));
  573.    END;
  574.  END;
  575. END  Round;
  576.  
  577. (*===========================================================================*)
  578.  
  579. BEGIN  (* MathBase *)
  580.   MINlongint := -2147483648.0D;
  581.  
  582.   WITH  lr  DO
  583.     chh := 0010H;
  584.     chl := 0000H;
  585.     clh := 0000H;
  586.     cll := 0000H;
  587.  
  588.     MINLONGREAL := longreal;
  589.   END;
  590.  
  591.   MAXrlint := MAXlongint + ( -0.5D );
  592.   MINrlint := MINlongint + 0.5D;
  593.  
  594.   MAXrint  := MAXint - 0.5;
  595.   MINrint  := MINint + 0.5;
  596.  
  597.  
  598. END MathBase.
  599.